home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8307.arc / KSCOPE.BAS < prev    next >
BASIC Source File  |  1984-01-23  |  4KB  |  141 lines
  1. 1000 'File: KSCOPE.BAS
  2. 1010 'Auth: Thomas V. Hoffmann
  3. 1020 'Edit: TVH  18-April-83  6:00pm
  4. 1030 '
  5. 1040 DEFINT A-Z
  6. 1050 '----------
  7. 1060 'CGA Definitions
  8. 1070 '
  9. 1080 MODEREG = &H3D8: COLORREG = &H3D9   '-- CGA Control Registers
  10. 1090 MODESAVE = &H465: COLORSAVE = &H466 '-- BIOS Saves CGA Regs here
  11. 1100 CRTREG = &H3D4: CRTDATA = &H3D5     '-- 6845 CRT control regs
  12. 1110 HIRES=1: GRAPH=2: BW=4: VIDEO=8     '-- Mode register bits
  13. 1120 G640=16: BLINK=32                   '-- ..
  14. 1130 '
  15. 1140 '----------
  16. 1150 ' Set MONO to 1 if both adapters installed
  17. 1160 '             0 if color adapter only
  18. 1170 '
  19. 1180 MONO = 1
  20. 1190 '
  21. 1200 '----------
  22. 1210 ' Set F3=Load Picture, F4=Save Picture, F10=Exit
  23. 1220 '
  24. 1230 KEY ON: KEY (3) ON: KEY (4) ON: KEY (10) ON
  25. 1232 ON KEY(3) GOSUB 9300
  26. 1234 ON KEY(4) GOSUB 9400
  27. 1240 ON KEY(10) GOSUB 9900
  28. 1250 '
  29. 1260 '----------
  30. 1270 ' Initialize Color, Cycle Counter
  31. 1280 '
  32. 1290 PCOLOR=1
  33. 1300 TIMES=0
  34. 1310 INPUT "How many cycles per color change";MAXTIMES
  35. 1312 INPUT "Highest color number"; MAXCOLOR
  36. 1320 '----------
  37. 1330 'Setup Color Adapter for 160x100 Alpha Graphics
  38. 1340 '
  39. 1350 DEF SEG=0
  40. 1360 MODE = 0   '-- Turn off Video During Setup
  41. 1370 POKE MODESAVE,MODE: OUT MODEREG,MODE
  42. 1380 POKE COLORSAVE,0: OUT COLORREG,0
  43. 1390 '
  44. 1400 '-- Load New Parameters into 6845 CRT Controller
  45. 1410 FOR REG = 0 TO 11
  46. 1420   READ REGDATA
  47. 1430   OUT CRTREG, REG: OUT CRTDATA, REGDATA
  48. 1440 NEXT REG
  49. 1450 '
  50. 1460 '-- Set Mode for 80 Column Color and Enable
  51. 1470 MODE = HIRES + VIDEO
  52. 1480 POKE MODESAVE,MODE: OUT MODEREG,MODE
  53. 1490 '
  54. 1500 '-- Clear Screen: Character = &HDE, Attributes = 0
  55. 1510 DEF SEG = &HB800
  56. 1520 FOR CHAR = 0 TO 15998 STEP 2: POKE CHAR,&HDE: NEXT CHAR
  57. 1530 FOR ATTR = 1 TO 15999 STEP 2: POKE ATTR,0   : NEXT ATTR
  58. 1540 '
  59. 1550 '----------
  60. 1560 ' Generate Random Coordinates and Color
  61. 1570 '   and Reflect 8 Ways
  62. 1580 '
  63. 1590 BEEP
  64. 1600 WHILE 1 '-- Repeat until F10 struck
  65. 1610   TIMES = TIMES + 1
  66. 1620   IF TIMES > MAXTIMES THEN TIMES=0: PCOLOR=(PCOLOR+1) MOD (MAXCOLOR+1)
  67. 1630   X = RND*79: Y= RND*49
  68. 1640   GOSUB 4000
  69. 1650   IF X<79 THEN SWAP X,Y: GOSUB 4000
  70. 1660 WEND
  71. 4000 '----------
  72. 4010 ' Plot PCOLOR Symmetrically in each quadrant
  73. 4015 '
  74. 4020   X=159-X: GOSUB 5000
  75. 4030   Y= 99-Y: GOSUB 5000
  76. 4040   X=159-X: GOSUB 5000
  77. 4050   Y= 99-Y: GOSUB 5000
  78. 4060 RETURN
  79. 5000 '----------
  80. 5010 ' Plot PCOLOR at (X,Y)
  81. 5020 '
  82. 5030 PIXEL = X+(Y*160): PIXELADDR = (PIXEL AND &HFFFE) + 1
  83. 5040 NIBBLE = PIXEL MOD 2
  84. 5050 IF NIBBLE=0 THEN POKE PIXELADDR,(PEEK(PIXELADDR) AND &HF ) + PCOLOR * &H10
  85. 5060 IF NIBBLE=1 THEN POKE PIXELADDR,(PEEK(PIXELADDR) AND &HF0) + PCOLOR
  86. 5070 RETURN
  87. 7000 '----------
  88. 7010 ' Switch to Color/Graphics Display
  89. 7020 '
  90. 7030 DEF SEG=0: A=PEEK(&H410): POKE &H410,(A AND &HCF) OR &H20
  91. 7040 WIDTH 40: SCREEN 1: SCREEN 0: LOCATE ,,1,6,7
  92. 7050 RETURN
  93. 7060 '
  94. 7100 '----------
  95. 7110 ' Conditionally Switch to Monochrome Display
  96. 7120 '
  97. 7130 IF MONO <> 1 THEN GOSUB 7000: RETURN
  98. 7140 DEF SEG=0: A=PEEK(&H410): POKE &H410,(A OR &H30)
  99. 7150 WIDTH 80: LOCATE ,,1,12,13: SCREEN 0,0,0
  100. 7160 KEY ON
  101. 7170 RETURN
  102. 7180 '
  103. 8000 '----------
  104. 8010 ' Initial Data for 6845 (80x100 characters)
  105. 8020 '
  106. 8030 DATA 113  :'-- R0  Horizontal Total
  107. 8040 DATA  80  :'-- R1  Horizontal Displayed
  108. 8050 DATA  90  :'-- R2  Horizontal Sync Position
  109. 8060 DATA  10  :'-- R3  Horizontal Sync Width
  110. 8070 DATA 127  :'-- R4  Vertical Total
  111. 8080 DATA   6  :'-- R5  Vertical Adjust
  112. 8090 DATA 100  :'-- R6  Vertical Displayed
  113. 8100 DATA 112  :'-- R7  Vertical Sync Position
  114. 8110 DATA   2  :'-- R8  Interlace Mode (non-interlace)
  115. 8120 DATA   1  :'-- R9  Maximum Scan Line Address
  116. 8130 DATA  32  :'-- R10 Cursor Start (disables cursor display)
  117. 8140 DATA   0  :'-- R11 Cursor End
  118. 8150 '----------
  119. 9300 '----------
  120. 9310 ' F3 - Load Picture File
  121. 9320 '
  122. 9330 INPUT "Load from file: ", PIC$
  123. 9340 BLOAD PIC$,0
  124. 9345 INPUT "Press enter to continue...",JUNK$
  125. 9350 RETURN
  126. 9360 '
  127. 9400 '----------
  128. 9410 ' F4 - Save Picture File
  129. 9420 '
  130. 9430 INPUT "Save in file: ", PIC$
  131. 9440 BSAVE PIC$,0,16000
  132. 9445 INPUT "Press enter to continue...",JUNK$
  133. 9450 RETURN
  134. 9460 '
  135. 9900 '----------
  136. 9910 ' F10 - Exit
  137. 9920 '
  138. 9930 GOSUB 7100 '-- return to monochrome
  139. 9940 END        '-- and quit
  140. 9999 END
  141.